home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / libs / oasys / oac.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-03-27  |  25.3 KB  |  1,457 lines
  1. #include    <stdio.h>
  2. #include    <io.h>
  3. #include    <limits.h>
  4. #include    <assert.h>
  5. #include    <stdlib.h>
  6. #include    <string.h>
  7. #include    <stdarg.h>
  8. #include    <rwlib.h>
  9. #include    "ins.h"
  10.  
  11. enum
  12. {
  13.     TK_ID,
  14.     TK_INT,
  15.     TK_STR,
  16. };
  17.  
  18. struct token
  19. {
  20.     int type;
  21.     union
  22.     {
  23.         int i;
  24.         char *s;
  25.     };
  26. };
  27.  
  28. struct word: slist
  29. {
  30.     char *name;
  31. };
  32.  
  33. struct phrase: slist
  34. {
  35.     slisthead words;
  36. };
  37.  
  38. struct variable: slist
  39. {
  40.     char *name;
  41.     int type;
  42. };
  43.  
  44. struct arg: variable
  45. {
  46.     int selector;
  47. };
  48.  
  49. struct instruction: slist
  50. {
  51.     int op;
  52.     int i;
  53. };
  54.  
  55. struct method: slist
  56. {
  57.     char *name;
  58.     int type;
  59.     slisthead args;
  60.     slisthead verbs;
  61.     int noselect;
  62.     slisthead variables;
  63.     slisthead code;
  64. };
  65.  
  66. struct Class: slist
  67. {
  68.     char *name;
  69.     slisthead nouns;
  70. };
  71.  
  72. parseexp (method *);
  73.  
  74. char *keyword[] =
  75. {
  76.     "int",
  77.     "string",
  78.     "object",
  79.     "class",
  80.     "method",
  81.     "verbs",
  82.     "if",
  83.     "else",
  84.     "print",
  85.     "and",
  86.     "or",
  87.     "do",
  88.     "while",
  89.     "property",
  90.     "destroy",
  91.     "create",
  92.     "exit",
  93.     "quit",
  94.     "this",
  95.     "return",
  96.     "not",
  97.     "break",
  98.     "continue",
  99.     "exists",
  100.     "save",
  101.     "load",
  102.     "player",
  103.     "init",
  104.     "select_addressee",
  105.     "random",
  106.     "is",
  107.     "next",
  108. };
  109.  
  110. enum
  111. {
  112.     KW_INT,
  113.     KW_STRING,
  114.     KW_OBJECT,
  115.     KW_CLASS,
  116.     KW_METHOD,
  117.     KW_VERBS,
  118.     KW_IF,
  119.     KW_ELSE,
  120.     KW_PRINT,
  121.     KW_AND,
  122.     KW_OR,
  123.     KW_DO,
  124.     KW_WHILE,
  125.     KW_PROPERTY,
  126.     KW_DESTROY,
  127.     KW_CREATE,
  128.     KW_EXIT,
  129.     KW_QUIT,
  130.     KW_THIS,
  131.     KW_RETURN,
  132.     KW_NOT,
  133.     KW_BREAK,
  134.     KW_CONTINUE,
  135.     KW_EXISTS,
  136.     KW_SAVE,
  137.     KW_LOAD,
  138.     KW_PLAYER,
  139.     KW_INIT,
  140.     KW_SELECT_ADDRESSEE,
  141.     KW_RANDOM,
  142.     KW_IS,
  143.     KW_NEXT,
  144.     MAXKEYWORDS,
  145. };
  146.  
  147. #define    ID_INT                    keyword[KW_INT]
  148. #define    ID_STRING                keyword[KW_STRING]
  149. #define    ID_OBJECT                keyword[KW_OBJECT]
  150. #define    ID_CLASS                    keyword[KW_CLASS]
  151. #define    ID_METHOD                keyword[KW_METHOD]
  152. #define    ID_VERBS                    keyword[KW_VERBS]
  153. #define    ID_IF                        keyword[KW_IF]
  154. #define    ID_ELSE                    keyword[KW_ELSE]
  155. #define    ID_PRINT                    keyword[KW_PRINT]
  156. #define    ID_AND                    keyword[KW_AND]
  157. #define    ID_OR                        keyword[KW_OR]
  158. #define    ID_DO                        keyword[KW_DO]
  159. #define    ID_WHILE                    keyword[KW_WHILE]
  160. #define    ID_PROPERTY                keyword[KW_PROPERTY]
  161. #define    ID_DESTROY                keyword[KW_DESTROY]
  162. #define    ID_CREATE                keyword[KW_CREATE]
  163. #define    ID_EXIT                    keyword[KW_EXIT]
  164. #define    ID_QUIT                    keyword[KW_QUIT]
  165. #define    ID_THIS                    keyword[KW_THIS]
  166. #define    ID_RETURN                keyword[KW_RETURN]
  167. #define    ID_NOT                    keyword[KW_NOT]
  168. #define    ID_BREAK                    keyword[KW_BREAK]
  169. #define    ID_CONTINUE                keyword[KW_CONTINUE]
  170. #define    ID_EXISTS                keyword[KW_EXISTS]
  171. #define    ID_SAVE                    keyword[KW_SAVE]
  172. #define    ID_LOAD                    keyword[KW_LOAD]
  173. #define    ID_PLAYER                keyword[KW_PLAYER]
  174. #define    ID_INIT                    keyword[KW_INIT]
  175. #define    ID_SELECT_ADDRESSEE    keyword[KW_SELECT_ADDRESSEE]
  176. #define    ID_RANDOM                keyword[KW_RANDOM]
  177. #define    ID_IS                        keyword[KW_IS]
  178. #define    ID_NEXT                    keyword[KW_NEXT]
  179.  
  180. FILE *inf;
  181. int line = 1;
  182. int nxch;
  183. token nxtk;
  184. tree symhead = { strcmp };
  185. int bad;
  186. slisthead strings;
  187. int nstrings = 1;
  188. slisthead variables;
  189. slisthead properties;
  190. slisthead classes;
  191. slisthead methods;
  192. int stack[256];
  193. int sp;
  194. int file;
  195. ftree vocabtree = { strcmp };
  196. char **vocablist;
  197. int nvocab;
  198.  
  199. inline myisalpha (int c)
  200. {
  201.     return isalpha (c) || c == '_';
  202. }
  203.  
  204. inline myisalnum (int c)
  205. {
  206.     return isalnum (c) || c == '_';
  207. }
  208.  
  209. void error (char *format ...)
  210. {
  211.     va_list argptr;
  212.     va_start (argptr,format);
  213.     printf ("Fatal Error line %d: ",line);
  214.     vprintf (format,argptr);
  215.     va_end (argptr);
  216.     putchar ('\n');
  217.     exit (1);
  218. }
  219.  
  220. void warning (char *format ...)
  221. {
  222.     va_list argptr;
  223.     va_start (argptr,format);
  224.     printf ("Error line %d: ",line);
  225.     vprintf (format,argptr);
  226.     va_end (argptr);
  227.     putchar ('\n');
  228.     bad = TRUE;
  229. }
  230.  
  231. inline void readch ()
  232. {
  233.     if ((nxch = fgetc (inf)) == '\n')
  234.         line++;
  235. }
  236.  
  237. void lexinit (char *filename)
  238. {
  239.     inf = Fopen (filename,"r");
  240.     readch ();
  241. }
  242.  
  243. void lex ()
  244. {
  245.     static char buf[10240];
  246.     int i;
  247. LOOP:
  248.     while (isspace (nxch))
  249.         readch ();
  250.     if (myisalpha (nxch))
  251.     {
  252.         i = 0;
  253.         do
  254.         {
  255.             buf[i++] = tolower (nxch);
  256.             readch ();
  257.         }
  258.         while (myisalnum (nxch));
  259.         buf[i] = 0;
  260.         nxtk.type = TK_ID;
  261.         nxtk.s = strdup (buf);
  262.         nxtk.s = (char *)(symhead += nxtk.s);
  263.         return;
  264.     }
  265.     if (isdigit (nxch))
  266.     {
  267.         i = 0;
  268.         do
  269.         {
  270.             buf[i++] = nxch;
  271.             readch ();
  272.         }
  273.         while (isdigit (nxch));
  274.         buf[i] = 0;
  275.         nxtk.type = TK_INT;
  276.         nxtk.i = atoi (buf);
  277.         return;
  278.     }
  279.     switch (nxch)
  280.     {
  281.         case '"':
  282.             i = 0;
  283.             do
  284.             {
  285.                 readch ();
  286.                 while (nxch != '"')
  287.                 {
  288.                     if (nxch == EOF)
  289.                     {
  290.                         nxtk.type = EOF;
  291.                         return;
  292.                     }
  293.                     if (nxch == '\n')
  294.                         nxch = ' ';
  295.                     if (nxch == '\\')
  296.                     {
  297.                         int tempch;
  298.                         readch ();
  299.                         switch (nxch)
  300.                         {
  301.                             case 'n':
  302.                             case 'N':
  303.                                 buf[i++] = '\n';
  304.                                 break;
  305.                             case '"':
  306.                                 buf[i++] = '"';
  307.                                 break;
  308.                             default:
  309.                                 tempch = nxch;
  310.                                 readch ();
  311.                                 buf[i++] = hexchars2byte (tempch,nxch);
  312.                         }
  313.                     }
  314.                     else
  315.                         buf[i++] = nxch;
  316.                     if (i >= sizeof (buf))
  317.                         error ("String too long");
  318.                     readch ();
  319.                 }
  320.                 do
  321.                     readch ();
  322.                 while (isspace (nxch));
  323.             }
  324.             while (nxch == '"');
  325.             buf[i] = 0;
  326.             nxtk.type = TK_STR;
  327.             nxtk.s = strdup (buf);
  328.             return;
  329.         case '+':
  330.         case '-':
  331.         case '*':
  332.         case '%':
  333.         case '{':
  334.         case '}':
  335.         case '(':
  336.         case ')':
  337.         case EOF:
  338.             nxtk.type = nxch;
  339.             readch ();
  340.             return;
  341.         case '/':
  342.             readch ();
  343.             switch (nxch)
  344.             {
  345.                 case '/':
  346.                      do
  347.                         readch ();
  348.                     while (nxch != '\n' && nxch != EOF);
  349.                     goto LOOP;
  350.                 case '*':
  351.                     readch ();
  352.                     do
  353.                     {
  354.                         while (nxch != '*')
  355.                         {
  356.                             if (nxch == EOF)
  357.                             {
  358.                                 nxtk.type = EOF;
  359.                                 return;
  360.                             }
  361.                             readch ();
  362.                         }
  363.                         readch ();
  364.                         if (nxch == EOF)
  365.                         {
  366.                             nxtk.type = EOF;
  367.                             return;
  368.                         }
  369.                     }
  370.                     while (nxch != '/');
  371.                     readch ();
  372.                     goto LOOP;
  373.                 default:
  374.                     nxtk.type = '/';
  375.                     return;
  376.             }
  377.         case '=':
  378.             nxtk.type = '=';
  379.             readch ();
  380.             if (nxch == '=')
  381.             {
  382.                 readch ();
  383.                 nxtk.type = '==';
  384.             }
  385.             return;
  386.         case '>':
  387.             nxtk.type = '>';
  388.             readch ();
  389.             if (nxch == '=')
  390.             {
  391.                 readch ();
  392.                 nxtk.type = '>=';
  393.             }
  394.             return;
  395.         case '<':
  396.             nxtk.type = '<';
  397.             readch ();
  398.             if (nxch == '=')
  399.             {
  400.                 readch ();
  401.                 nxtk.type = '<=';
  402.             }
  403.             return;
  404.         case '!':
  405.             readch ();
  406.             if (nxch == '=')
  407.             {
  408.                 readch ();
  409.                 nxtk.type = '!=';
  410.                 return;
  411.             }
  412.             error ("Bad character %c",'!');
  413.         default:
  414.             error ("Bad character %c",nxch);
  415.     }
  416. }
  417.  
  418. typedecl ()
  419. {
  420.     return nxtk.type == TK_ID &&
  421.             (nxtk.s == ID_INT || nxtk.s == ID_STRING || nxtk.s == ID_OBJECT);
  422. }
  423.  
  424. char *parseid ()
  425. {
  426.     if (nxtk.type != TK_ID)
  427.         error ("Identifier expected");
  428.     char *s = nxtk.s;
  429.     lex ();
  430.     return s;
  431. }
  432.  
  433. isid (char *s)
  434. {
  435.     return nxtk.type == TK_ID && nxtk.s == s;
  436. }
  437.  
  438. void parseid (char *s)
  439. {
  440.     if (!isid (s))
  441.         error ("\"%s\" expected",s);
  442.     lex ();
  443. }
  444.  
  445. variable *parsevariable ()
  446. {
  447.     variable *v = new variable;
  448.     if (nxtk.s == ID_INT)
  449.         v->type = T_INT;
  450.     if (nxtk.s == ID_STRING)
  451.         v->type = T_STR;
  452.     if (nxtk.s == ID_OBJECT)
  453.         v->type = T_OBJECT;
  454.     lex ();
  455.     v->name = parseid ();
  456.     return v;
  457. }
  458.  
  459. arg *parsearg ()
  460. {
  461.     arg *a = new arg;
  462.     if (nxtk.s == ID_INT)
  463.         a->type = T_INT;
  464.     if (nxtk.s == ID_STRING)
  465.         a->type = T_STR;
  466.     if (nxtk.s == ID_OBJECT)
  467.         a->type = T_OBJECT;
  468.     lex ();
  469.     a->name = parseid ();
  470.     if (a->type == T_OBJECT && nxtk.type == TK_ID && nxtk.s != ID_VERBS)
  471.     {
  472.         char *s = nxtk.s;
  473.         method *m;
  474.         int i;
  475.         for (m=(method *)methods.next,i=0 ; m ; m=(method *)m->next,i++)
  476.             if (m->name == s)
  477.             {
  478.                 if (m->type != T_INT)
  479.                     warning ("Selector method \"%s\" should be of int type",s);
  480.                 if (m->args.next)
  481.                     warning ("Selector method \"%s\" should not take arguments",s);
  482.                 a->selector = i;
  483.                 lex ();
  484.                 return a;
  485.             }
  486.     }
  487.     a->selector = -1;
  488.     return a;
  489. }
  490.  
  491. void parsepunct (int c)
  492. {
  493.     if (nxtk.type != c)
  494.         error ("%c expected",c);
  495.     lex ();
  496. }
  497.  
  498. word *parseword ()
  499. {
  500.     word *w = new word;
  501.     w->name = parseid ();
  502.     vocabtree += w->name;
  503.     return w;
  504. }
  505.  
  506. void parsewordlist (slisthead *h)
  507. {
  508.     parsepunct ('{');
  509.     while (nxtk.type == TK_ID)
  510.         *h += parseword ();
  511.     parsepunct ('}');
  512. }
  513.  
  514. void parsephraselist (slisthead *h)
  515. {
  516.     parsepunct ('{');
  517.     while (nxtk.type == '{')
  518.     {
  519.         phrase *p = new phrase;
  520.         parsewordlist (&p->words);
  521.         *h += p;
  522.     }
  523.     parsepunct ('}');
  524. }
  525.  
  526. instruction *addi (method *m,int i)
  527. {
  528.     instruction *I = new instruction;
  529.     m->code += I;
  530.     I->op = i;
  531.     I->i = 0;
  532.     return I;
  533. }
  534.  
  535. parseclassref ()
  536. {
  537.     Class *c;
  538.     int i;
  539.     if (nxtk.type != TK_ID)
  540.         error ("Class name expected");
  541.     for (c=(Class *)classes.next,i=0 ; c ; c=(Class *)c->next,i++)
  542.         if (c->name == nxtk.s)
  543.         {
  544.             lex ();
  545.             return i;
  546.         }
  547.     error ("Class name expected");
  548. }
  549.  
  550. findvar (slisthead *h,char *s,variable **result)
  551. {
  552.     variable *v;
  553.     int i;
  554.     for (v=(variable *)h->next,i=0 ; v ; v=(variable *)v->next,i++)
  555.         if (v->name == s)
  556.         {
  557.             *result = v;
  558.             return i;
  559.         }
  560.     return -1;
  561. }
  562.  
  563. void push (int i)
  564. {
  565.     if (sp == sizeof(stack) / sizeof (int))
  566.         error ("Expression too complex");
  567.     stack[sp++] = i;
  568. }
  569.  
  570. pop ()
  571. {
  572.     if (sp == 0)
  573.         error ("Void type used in expression");
  574.     return stack[--sp];
  575. }
  576.  
  577. void popobject ()
  578. {
  579.     if (pop () != T_OBJECT)
  580.         warning ("Type must be object");
  581. }
  582.  
  583. void popstr ()
  584. {
  585.     if (pop () != T_STR)
  586.         warning ("Type must be string");
  587. }
  588.  
  589. void popint ()
  590. {
  591.     if (pop () != T_INT)
  592.         warning ("Type must be int");
  593. }
  594.  
  595. parsefactor (method *m)
  596. {
  597.     int i;
  598.     method *m2;
  599.     int n;
  600.     variable *v;
  601.     word *w;
  602.     switch (nxtk.type)
  603.     {
  604.         case '-':
  605.             lex ();
  606.             n = parsefactor (m) + 1;
  607.             popint ();
  608.             addi (m,I_MINUS);
  609.             push (T_INT);
  610.             return n;
  611.         case TK_INT:
  612.             addi (m,I_INT)->i = nxtk.i;
  613.             push (T_INT);
  614.             lex ();
  615.             return 1;
  616.         case TK_STR:
  617.             w = new word;
  618.             w->name = nxtk.s;
  619.             strings += w;
  620.             addi (m,I_INT)->i = nstrings++;
  621.             push (T_STR);
  622.             lex ();
  623.             return 1;
  624.         case '(':
  625.             lex ();
  626.             n = parseexp (m);
  627.             parsepunct (')');
  628.             break;
  629.         case TK_ID:
  630.             if (nxtk.s == ID_LOAD)
  631.             {
  632.                 lex ();
  633.                 addi (m,I_LOAD);
  634.                 push (T_INT);
  635.                 return 1;
  636.             }
  637.             if (nxtk.s == ID_RANDOM)
  638.             {
  639.                 lex ();
  640.                 n = parseexp (m) + 1;
  641.                 popint ();
  642.                 addi (m,I_RANDOM);
  643.                 push (T_INT);
  644.                 return n;
  645.             }
  646.             if (nxtk.s == ID_NOT)
  647.             {
  648.                 lex ();
  649.                 n = parsefactor (m) + 1;
  650.                 popint ();
  651.                 addi (m,I_NOT);
  652.                 push (T_INT);
  653.                 return n;
  654.             }
  655.             if (nxtk.s == ID_CREATE)
  656.             {
  657.                 lex ();
  658.                 addi (m,I_CREATE)->i = parseclassref ();
  659.                 push (T_OBJECT);
  660.                 n = 1;
  661.                 break;
  662.             }
  663.             if (nxtk.s == ID_THIS)
  664.             {
  665.                 lex ();
  666.                 addi (m,I_THIS);
  667.                 push (T_OBJECT);
  668.                 n = 1;
  669.                 break;
  670.             }
  671.             if (nxtk.s == ID_OBJECT)
  672.             {
  673.                 lex ();
  674.                 n = parseexp (m) + 1;
  675.                 popint ();
  676.                 addi (m,I_OBJECT);
  677.                 push (T_OBJECT);
  678.                 break;
  679.             }
  680.             i = findvar (&m->variables,nxtk.s,&v);
  681.             if (i >= 0)
  682.             {
  683.                 addi (m,I_REFLOCALVAR)->i = i;
  684.                 lex ();
  685.                 n = 1;
  686.                 if (nxtk.type != '=')
  687.                 {
  688.                     addi (m,I_DEREF);
  689.                     push (v->type);
  690.                     n = 2;
  691.                 }
  692.                 else
  693.                     push (v->type | T_REF);
  694.                 break;
  695.             }
  696.             i = findvar (&m->args,nxtk.s,&v);
  697.             if (i >= 0)
  698.             {
  699.                 addi (m,I_REFARG)->i = i;
  700.                 lex ();
  701.                 n = 1;
  702.                 if (nxtk.type != '=')
  703.                 {
  704.                     addi (m,I_DEREF);
  705.                     push (v->type);
  706.                     n = 2;
  707.                 }
  708.                 else
  709.                     push (v->type | T_REF);
  710.                 break;
  711.             }
  712.             i = findvar (&variables,nxtk.s,&v);
  713.             if (i >= 0)
  714.             {
  715.                 addi (m,I_REFGLOBALVAR)->i = i;
  716.                 lex ();
  717.                 n = 1;
  718.                 if (nxtk.type != '=')
  719.                 {
  720.                     addi (m,I_DEREF);
  721.                     push (v->type);
  722.                     n = 2;
  723.                 }
  724.                 else
  725.                     push (v->type | T_REF);
  726.                 break;
  727.             }
  728.             error ("\"%s\" is not a valid expression",nxtk.s);
  729.         default:
  730.             error ("Expression expected");
  731.     }
  732.     for (;;)
  733.     {
  734.         if (nxtk.type != TK_ID)
  735.             return n;
  736.         if (nxtk.s == ID_EXISTS)
  737.         {
  738.             lex ();
  739.             popobject ();
  740.             addi (m,I_EXISTS);
  741.             push (T_INT);
  742.             return n + 1;
  743.         }
  744.         if (nxtk.s == ID_IS)
  745.         {
  746.             lex ();
  747.             popobject ();
  748.             addi (m,I_IS)->i = parseclassref ();
  749.             push (T_INT);
  750.             return n + 1;
  751.         }
  752.         if (nxtk.s == ID_NEXT)
  753.         {
  754.             lex ();
  755.             popobject ();
  756.             addi (m,I_NEXT);
  757.             push (T_OBJECT);
  758.             n++;
  759.             continue;
  760.         }
  761.         i = findvar (&properties,nxtk.s,&v);
  762.         if (i >= 0)
  763.         {
  764.             lex ();
  765.             addi (m,I_REFPROPERTY)->i = i;
  766.             popobject ();
  767.             n++;
  768.             if (nxtk.type != '=')
  769.             {
  770.                 addi (m,I_DEREF);
  771.                 push (v->type);
  772.                 n++;
  773.             }
  774.             else
  775.                 push (v->type | T_REF);
  776.             continue;
  777.         }
  778.         for (m2=(method *)methods.next,i=0 ; m2 ; m2=(method *)m2->next,i++)
  779.             if (m2->name == nxtk.s)
  780.                 break;
  781.         if (m2)
  782.         {
  783.             lex ();
  784.             popobject ();
  785.             for (v=(variable *)m2->args.next ; v ; v=(variable *)v->next)
  786.             {
  787.                 n += parseexp (m);
  788.                 if (pop () != v->type)
  789.                     warning ("Argument of wrong type for \"%s\"",m2->name);
  790.             }
  791.             n++;
  792.             if (m2->type == T_VOID)
  793.                 addi (m,I_CALLPROC)->i = i;
  794.             else
  795.             {
  796.                 addi (m,I_CALLFUNC)->i = i;
  797.                 push (m2->type);
  798.             }
  799.             continue;
  800.         }
  801.         return n;
  802.     }
  803. }
  804.  
  805. parseterm (method *m)
  806. {
  807.     int n = parsefactor (m);
  808.     while (nxtk.type == '*' || nxtk.type == '/' || nxtk.type == '%')
  809.     {
  810.         int i = nxtk.type;
  811.         lex ();
  812.         popint ();
  813.         n += parsefactor (m) + 1;
  814.         popint ();
  815.         switch (i)
  816.         {
  817.             case '*':
  818.                 addi (m,I_MUL);
  819.                 break;
  820.             case '/':
  821.                 addi (m,I_DIV);
  822.                 break;
  823.             case '%':
  824.                 addi (m,I_MOD);
  825.                 break;
  826.         }
  827.         push (T_INT);
  828.     }
  829.     return n;
  830. }
  831.  
  832. parsemathexp (method *m)
  833. {
  834.     int n = parseterm (m);
  835.     while (nxtk.type == '+' || nxtk.type == '-')
  836.     {
  837.         int i = nxtk.type;
  838.         lex ();
  839.         popint ();
  840.         n += parseterm (m) + 1;
  841.         popint ();
  842.         switch (i)
  843.         {
  844.             case '+':
  845.                 addi (m,I_ADD);
  846.                 break;
  847.             case '-':
  848.                 addi (m,I_SUB);
  849.                 break;
  850.         }
  851.         push (T_INT);
  852.     }
  853.     return n;
  854. }
  855.  
  856. parserelexp (method *m)
  857. {
  858.     int n = parsemathexp (m);
  859.     while (nxtk.type == '>' || nxtk.type == '<' || nxtk.type == '>=' ||
  860.             nxtk.type == '<=')
  861.     {
  862.         int i = nxtk.type;
  863.         lex ();
  864.         popint ();
  865.         n += parsemathexp (m) + 1;
  866.         popint ();
  867.         switch (i)
  868.         {
  869.             case '>':
  870.                 addi (m,I_GT);
  871.                 break;
  872.             case '<':
  873.                 addi (m,I_LT);
  874.                 break;
  875.             case '>=':
  876.                 addi (m,I_GE);
  877.                 break;
  878.             case '<=':
  879.                 addi (m,I_LE);
  880.                 break;
  881.         }
  882.         push (T_INT);
  883.     }
  884.     return n;
  885. }
  886.  
  887. parseeqexp (method *m)
  888. {
  889.     int n = parserelexp (m);
  890.     while (nxtk.type == '==' || nxtk.type == '!=')
  891.     {
  892.         int i = nxtk.type;
  893.         lex ();
  894.         n += parserelexp (m) + 1;
  895.         switch (pop ())
  896.         {
  897.             case T_INT:
  898.                 popint ();
  899.                 switch (i)
  900.                 {
  901.                     case '==':
  902.                         addi (m,I_EQ);
  903.                         break;
  904.                     case '!=':
  905.                         addi (m,I_NE);
  906.                         break;
  907.                 }
  908.                 break;
  909.             case T_STR:
  910.                 popstr ();
  911.                 switch (i)
  912.                 {
  913.                     case '==':
  914.                         addi (m,I_EQ);
  915.                         break;
  916.                     case '!=':
  917.                         addi (m,I_NE);
  918.                         break;
  919.                 }
  920.                 break;
  921.             case T_OBJECT:
  922.                 popobject ();
  923.                 switch (i)
  924.                 {
  925.                     case '==':
  926.                         addi (m,I_OEQ);
  927.                         break;
  928.                     case '!=':
  929.                         addi (m,I_ONE);
  930.                         break;
  931.                 }
  932.                 break;
  933.             default:
  934.                 assert (FALSE);
  935.         }
  936.         push (T_INT);
  937.     }
  938.     return n;
  939. }
  940.  
  941. parseandexp (method *m)
  942. {
  943.     int n = parseeqexp (m);
  944.     while (isid (ID_AND))
  945.     {
  946.         lex ();
  947.         popint ();
  948.         n += parseeqexp (m) + 1;
  949.         popint ();
  950.         addi (m,I_AND);
  951.         push (T_INT);
  952.     }
  953.     return n;
  954. }
  955.  
  956. parseexp (method *m)
  957. {
  958.     int n = parseandexp (m);
  959.     while (isid (ID_OR))
  960.     {
  961.         lex ();
  962.         popint ();
  963.         n += parseandexp (m) + 1;
  964.         popint ();
  965.         addi (m,I_OR);
  966.         push (T_INT);
  967.     }
  968.     return n;
  969. }
  970.  
  971. parsestatement (method *m)
  972. {
  973.     int n = 0;
  974.     int i,expi;
  975.     instruction *I,*oldI;
  976.     switch (nxtk.type)
  977.     {
  978.         case '{':
  979.             lex ();
  980.             while (nxtk.type != '}')
  981.                 n += parsestatement (m);
  982.             lex ();
  983.             break;
  984.         case TK_ID:
  985.             if (nxtk.s == ID_PRINT)
  986.             {
  987.                 lex ();
  988.                 n = parseexp (m) + 1;
  989.                 switch (pop ())
  990.                 {
  991.                     case T_INT:
  992.                         addi (m,I_PRINTINT);
  993.                         break;
  994.                     case T_STR:
  995.                         addi (m,I_PRINTSTR);
  996.                         break;
  997.                     default:
  998.                         warning ("Can only print int or string expression");
  999.                 }
  1000.                 break;
  1001.             }
  1002.             if (nxtk.s == ID_BREAK)
  1003.             {
  1004.                 lex ();
  1005.                 addi (m,I_BREAK)->i = -1;
  1006.                 n = 1;
  1007.                 break;
  1008.             }
  1009.             if (nxtk.s == ID_CONTINUE)
  1010.             {
  1011.                 lex ();
  1012.                 addi (m,I_CONTINUE)->i = -1;
  1013.                 n = 1;
  1014.                 break;
  1015.             }
  1016.             if (nxtk.s == ID_RETURN)
  1017.             {
  1018.                 lex ();
  1019.                 if (m->type == T_VOID)
  1020.                 {
  1021.                     addi (m,I_RETPROC);
  1022.                     n = 1;
  1023.                 }
  1024.                 else
  1025.                 {
  1026.                     n = parseexp (m) + 1;
  1027.                     if (pop () != m->type)
  1028.                         warning ("Return value of wrong type");
  1029.                     addi (m,I_RETFUNC);
  1030.                 }
  1031.                 break;
  1032.             }
  1033.             if (nxtk.s == ID_DESTROY)
  1034.             {
  1035.                 lex ();
  1036.                 n = parseexp (m) + 1;
  1037.                 addi (m,I_DESTROY);
  1038.                 popobject ();
  1039.                 break;
  1040.             }
  1041.             if (nxtk.s == ID_EXIT)
  1042.             {
  1043.                 lex ();
  1044.                 addi (m,I_EXIT);
  1045.                 n = 1;
  1046.                 break;
  1047.             }
  1048.             if (nxtk.s == ID_QUIT)
  1049.             {
  1050.                 lex ();
  1051.                 addi (m,I_QUIT);
  1052.                 n = 1;
  1053.                 break;
  1054.             }
  1055.             if (nxtk.s == ID_SAVE)
  1056.             {
  1057.                 lex ();
  1058.                 addi (m,I_SAVE);
  1059.                 n = 1;
  1060.                 break;
  1061.             }
  1062.             if (nxtk.s == ID_IF)
  1063.             {
  1064.                 lex ();
  1065.                 n = parseexp (m) + 1;
  1066.                 I = addi (m,I_JF);
  1067.                 popint ();
  1068.                 n += (i = parsestatement (m));
  1069.                 if (isid (ID_ELSE))
  1070.                 {
  1071.                     lex ();
  1072.                     I->i = i + 1;
  1073.                     I = addi (m,I_JMP);
  1074.                     n += (i = parsestatement (m)) + 1;
  1075.                 }
  1076.                   I->i = i;
  1077.                 break;
  1078.             }
  1079.             if (nxtk.s == ID_DO)
  1080.             {
  1081.                 lex ();
  1082.                 oldI = (instruction *)m->code.last;
  1083.                 n = expi = parsestatement (m);
  1084.                 parseid (ID_WHILE);
  1085.                 n += parseexp (m) + 1;
  1086.                 I = addi (m,I_JT);
  1087.                 popint ();
  1088.                 I->i = -n;
  1089.                 expi = n - expi;
  1090.                 for (I=(instruction *)oldI->next,i=n-1 ; I ; I=(instruction *)I->next,i--)
  1091.                     if (I->i < 0)
  1092.                     {
  1093.                         if (I->op == I_BREAK)
  1094.                         {
  1095.                             I->op = I_JMP;
  1096.                             I->i = i;
  1097.                         }
  1098.                         if (I->op == I_CONTINUE)
  1099.                         {
  1100.                             I->op = I_JMP;
  1101.                             I->i = i - expi;
  1102.                         }
  1103.                     }
  1104.                 break;
  1105.             }
  1106.             if (nxtk.s == ID_WHILE)
  1107.             {
  1108.                 lex ();
  1109.                 n = parseexp (m) + 1;
  1110.                 I = addi (m,I_JF);
  1111.                 popint ();
  1112.                 oldI = (instruction *)m->code.last;
  1113.                 n += (I->i = (i = parsestatement (m)) + 1);
  1114.                 I = addi (m,I_JMP);
  1115.                 I->i = -n;
  1116.                 for (I=(instruction *)oldI->next ; I ; I=(instruction *)I->next,i--)
  1117.                     if (I->i < 0)
  1118.                     {
  1119.                         if (I->op == I_BREAK)
  1120.                         {
  1121.                             I->op = I_JMP;
  1122.                             I->i = i;
  1123.                         }
  1124.                         if (I->op == I_CONTINUE)
  1125.                         {
  1126.                             I->op = I_JMP;
  1127.                             I->i = i - 1;
  1128.                         }
  1129.                     }
  1130.                 break;
  1131.             }
  1132.             n = parseexp (m);
  1133.             if (nxtk.type == '=')
  1134.             {
  1135.                 i = pop ();
  1136.                 if (!(i & T_REF))
  1137.                     warning ("Can only assign to variable or property");
  1138.                 lex ();
  1139.                 n += parseexp (m) + 1;
  1140.                 if ((i & 0x00ff) != pop ())
  1141.                     warning ("Different types in assignment");
  1142.                 addi (m,I_ASSIGN);
  1143.             }
  1144.             break;
  1145.         default:
  1146.             error ("Statement expected");
  1147.     }
  1148.     if (sp)
  1149.         warning ("Expression outside statement");
  1150.     return n;
  1151. }
  1152.  
  1153. void parsemethod ()
  1154. {
  1155.     method *m = new method;
  1156.     lex ();
  1157.     if (nxtk.type != TK_ID)
  1158.         error ("Identifier expected");
  1159.     m->type = T_VOID;
  1160.     if (nxtk.s == ID_INT)
  1161.     {
  1162.         m->type = T_INT;
  1163.         lex ();
  1164.     }
  1165.     else
  1166.         if (nxtk.s == ID_STRING)
  1167.         {
  1168.             m->type = T_STR;
  1169.             lex ();
  1170.         }
  1171.         else
  1172.             if (nxtk.s == ID_OBJECT)
  1173.             {
  1174.                 m->type = T_OBJECT;
  1175.                 lex ();
  1176.             }
  1177.     m->name = parseid ();
  1178.     for (method *m2=(method *)methods.next ; m2 ; m2=(method *)m2->next)
  1179.         if (m2->name == m->name)
  1180.             warning ("Method with duplicate name \"%s\"",m->name);
  1181.     while (typedecl ())
  1182.         m->args += parsearg ();
  1183.     if (isid (ID_VERBS))
  1184.     {
  1185.         lex ();
  1186.         parsephraselist (&m->verbs);
  1187.         for (arg *a=(arg *)m->args.next ; a ; a=(arg *)a->next)
  1188.             if (a->type == T_STR)
  1189.                 warning ("Method arguments may not be of string type");
  1190.     }
  1191.     m->noselect = -1;
  1192.     if (nxtk.type == TK_STR)
  1193.     {
  1194.         word *w = new word;
  1195.         w->name = nxtk.s;
  1196.         strings += w;
  1197.         m->noselect = nstrings++;
  1198.         lex ();
  1199.     }
  1200.     parsepunct ('{');
  1201.     while (typedecl ())
  1202.         m->variables += parsevariable ();
  1203.     methods += m;
  1204.     long n = 0;
  1205.     while (nxtk.type != '}')
  1206.         n += parsestatement (m);
  1207.     if (n*sizeof (int)*2 > UINT_MAX)
  1208.         warning ("Method too large");
  1209.     lex ();
  1210. }
  1211.  
  1212. Class *parseclass ()
  1213. {
  1214.     Class *c = new Class;
  1215.     lex ();
  1216.     c->name = parseid ();
  1217.     parsephraselist (&c->nouns);
  1218.     return c;
  1219. }
  1220.  
  1221. void parse (char *filename)
  1222. {
  1223.     for (int i=0 ; i<MAXKEYWORDS ; i++)
  1224.         symhead += keyword[i];
  1225.     lexinit (filename);
  1226.     lex ();
  1227.     variable *v = new variable;
  1228.     v->type = T_OBJECT;
  1229.     v->name = ID_PLAYER;
  1230.     variables += v;
  1231.     word *w = new word;
  1232.     w->name = "*NULL STRING*";
  1233.     strings += w;
  1234.     for (;;)
  1235.         switch (nxtk.type)
  1236.         {
  1237.             case EOF:
  1238.                 return;
  1239.             case TK_ID:
  1240.                 if (typedecl ())
  1241.                 {
  1242.                     variables += parsevariable ();
  1243.                     continue;
  1244.                 }
  1245.                 if (nxtk.s == ID_PROPERTY)
  1246.                 {
  1247.                     lex ();
  1248.                     properties += parsevariable ();
  1249.                     continue;
  1250.                 }
  1251.                 if (nxtk.s == ID_METHOD)
  1252.                 {
  1253.                     parsemethod ();
  1254.                     continue;
  1255.                 }
  1256.                 if (nxtk.s == ID_CLASS)
  1257.                 {
  1258.                     classes += parseclass ();
  1259.                     continue;
  1260.                 }
  1261.             default:
  1262.                 error ("Variable, method or class definition expected");
  1263.         }
  1264. }
  1265.  
  1266. findvocab (char *s)
  1267. {
  1268.     char **result = (char **)bsearch (&s,vocablist,nvocab,sizeof (char*),strpcmp);
  1269.     assert (result);
  1270.     return (int)(result - vocablist);
  1271. }
  1272.  
  1273. copyvocab (ftreenode *t,int i)
  1274. {
  1275.     if (!t)
  1276.         return 0;
  1277.     int n = copyvocab (t->left,i);
  1278.     vocablist[i+n] = (char *)t->data;
  1279.     return n + 1 + copyvocab (t->right,i+n+1);
  1280. }
  1281.  
  1282. void writeint (int i)
  1283. {
  1284.     Write (file,&i,sizeof (int));
  1285. }
  1286.  
  1287. void writephraselist (slisthead *h)
  1288. {
  1289.     writeint (h->len ());
  1290.     for (phrase *p=(phrase *)h->next ; p ; p=(phrase *)p->next)
  1291.     {
  1292.         writeint (p->words.len ());
  1293.         for (word *w=(word *)p->words.next ; w ; w=(word *)w->next)
  1294.             writeint (findvocab (w->name));
  1295.     }
  1296. }
  1297.  
  1298. treenode::size ()
  1299. {
  1300.     if (!this)
  1301.         return 0;
  1302.     return left->size () + 1 + right->size ();
  1303. }
  1304.  
  1305. void output (char *filename)
  1306. {
  1307.     int i,j;
  1308.     method *m;
  1309.     variable *v;
  1310.     word *w;
  1311.     phrase *p;
  1312.     Class *c;
  1313.     instruction *I;
  1314.  
  1315.     file = Create (filename);
  1316.  
  1317.     Write (file,"oas",4);
  1318.  
  1319.     writeint (nstrings);
  1320.     for (w=(word *)strings.next ; w ; w=(word *)w->next)
  1321.     {
  1322.         i = strlen (w->name);
  1323.         writeint (i);
  1324.         Write (file,w->name,i);
  1325.     }
  1326.     if (!nstrings)
  1327.         warning ("No strings defined");
  1328.  
  1329.     writeint (variables.len ());
  1330.     for (v=(variable *)variables.next ; v ; v=(variable *)v->next)
  1331.         writeint (v->type);
  1332.  
  1333.     i = properties.len ();
  1334.     if (i == 0)
  1335.         warning ("No properties defined");
  1336.     writeint (i);
  1337.     for (v=(variable *)properties.next ; v ; v=(variable *)v->next)
  1338.         writeint (v->type);
  1339.  
  1340.     nvocab = vocabtree.size ();
  1341.     writeint (nvocab);
  1342.     if (nvocab)
  1343.     {
  1344.         vocablist = new char *[nvocab];
  1345.         i = copyvocab (vocabtree.t,0);
  1346.         assert (i == nvocab);
  1347.         for (i=0 ; i<nvocab ; i++)
  1348.         {
  1349.             j = strlen (vocablist[i]);
  1350.             writeint (j);
  1351.             Write (file,vocablist[i],j);
  1352.         }
  1353.     }
  1354.     else
  1355.         warning ("No vocabulary defined");
  1356.  
  1357.     writeint (classes.len ());
  1358.     for (c=(Class *)classes.next ; c ; c=(Class *)c->next)
  1359.         writephraselist (&c->nouns);
  1360.  
  1361.     writeint (methods.len ());
  1362.     for (m=(method *)methods.next,i=0 ; m ; m=(method *)m->next,i++)
  1363.         if (m->name == ID_INIT)
  1364.         {
  1365.             if (m->type != T_VOID)
  1366.                 warning ("Init method should not return a value");
  1367.             if (m->args.next)
  1368.                 warning ("Init method should not take arguments");
  1369.             writeint (i);
  1370.             break;
  1371.         }
  1372.     if (!m)
  1373.         warning ("Init method not defined");
  1374.     for (m=(method *)methods.next,i=0 ; m ; m=(method *)m->next,i++)
  1375.         if (m->name == ID_SELECT_ADDRESSEE)
  1376.         {
  1377.             if (m->type != T_INT)
  1378.                 warning ("Select addressee method should return an int value");
  1379.             if (m->args.next)
  1380.                 warning ("Select addressee method should not take arguments");
  1381.             writeint (i);
  1382.             break;
  1383.         }
  1384.     if (!m)
  1385.         writeint (-1);
  1386.     for (m=(method *)methods.next ; m ; m=(method *)m->next)
  1387.     {
  1388.         writeint (m->type);
  1389.         writeint (m->args.len ());
  1390.         for (arg *a=(arg *)m->args.next ; a ; a=(arg *)a->next)
  1391.         {
  1392.             writeint (a->type);
  1393.             if (m->verbs.next)
  1394.             {
  1395.                 if (a->selector < 0 && a->type == T_OBJECT)
  1396.                     warning ("Command method \"%s\" has no selector on object argument",m->name);
  1397.             }
  1398.             else
  1399.                 if (a->selector >= 0)
  1400.                     warning ("Non-command method \"%s\" has selector on argument",
  1401.                             m->name);
  1402.             writeint (a->selector);
  1403.         }
  1404.         writeint (m->variables.len ());
  1405.         for (v=(variable *)m->variables.next ; v ; v=(variable *)v->next)
  1406.             writeint (v->type);
  1407.         writeint (m->verbs.len ());
  1408.         for (p=(phrase *)m->verbs.next ; p ; p=(phrase *)p->next)
  1409.         {
  1410.             writeint (p->words.len ());
  1411.             for (w=(word *)p->words.next ; w ; w=(word *)w->next)
  1412.             {
  1413.                 for (v=(variable *)m->args.next,i=0 ; v ; v=(variable *)v->next,i++)
  1414.                     if (v->name == w->name)
  1415.                         break;
  1416.                 if (v)
  1417.                     writeint (~i);
  1418.                 else
  1419.                     writeint (findvocab (w->name));
  1420.             }
  1421.         }
  1422.         writeint (m->noselect);
  1423.         if (m->noselect >= 0 && (m->args.next || m->type != T_INT))
  1424.             warning ("Non-selector method \"%s\" should not have message",m->name);
  1425.         writeint (m->code.len ());
  1426.         for (I=(instruction *)m->code.next ; I ; I=(instruction *)I->next)
  1427.         {
  1428.             if (I->op == I_BREAK)
  1429.                 warning ("BREAK outside loop");
  1430.             if (I->op == I_CONTINUE)
  1431.                 warning ("CONTINUE outside loop");
  1432.             Write (file,&I->op,2 * sizeof (int));
  1433.         }
  1434.     }
  1435.  
  1436.     close (file);
  1437. }
  1438.  
  1439. main (int argc,char **argv)
  1440. {
  1441.     printf ("Object-Oriented Adventure Compiler" VERSION "\n");
  1442.     if (argc != 2 || !strcmp (argv[1],"?"))
  1443.         perr ("Usage: oac filename");
  1444.     parse (defext (argv[1],".s"));
  1445.     int i = strlen (argv[1]);
  1446.     while (--i >= 0)
  1447.         if (argv[1][i] == '.')
  1448.         {
  1449.             argv[1][i] = 0;
  1450.             break;
  1451.         }
  1452.     output (argv[1]);
  1453.     if (bad)
  1454.         unlink (argv[1]);
  1455.     return bad;
  1456. }
  1457.